home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 10 / AACD 10.iso / AACD / Online / SpeakFreely / CONTRIB / xspeakfree-0.7 / lib / xspeakfree / open3.tcl < prev    next >
Text File  |  2000-05-16  |  2KB  |  104 lines
  1. # Shawn Pearce, <spearce@injersey.com>, 1997
  2. # similiar to perl's open2 and open3 comamnds
  3.  
  4. rename exit tcl_core:exit
  5.  
  6. set EXEC_cnt 0
  7.  
  8. proc open_exec {args} {
  9.     global EXEC EXEC_cnt
  10.     
  11.     incr EXEC_cnt
  12.  
  13.     foreach {n v} $args {
  14.         switch -exact -- $n {
  15.             -command { 
  16.                 set cmd {}
  17.                 foreach x [string trim $v] {
  18.                     if {$x != {} && $x != { }} { lappend cmd $x }
  19.                 }
  20.             }
  21.             -stdin { upvar 1 $v stdin; set stdin {} }
  22.             -stdout { upvar 1 $v stdout; set stdout {} }
  23.             -stderr { upvar 1 $v stderr; set stderr {} }
  24.         }
  25.     }
  26.  
  27.     set path "/tmp/tclsh-exec.[pid].$EXEC_cnt"
  28.     set EXEC(exec$EXEC_cnt:fd) {}
  29.  
  30.     if [info exists stdin] {
  31.         exec mkfifo "$path.0"
  32.         lappend tmpfd [open "$path.0" r+]
  33.         set stdin [open "$path.0" w]
  34.         
  35.         append cmd " <$path.0 "
  36.         lappend EXEC(exec$EXEC_cnt:fd) $stdin
  37.     }
  38.     if [info exists stdout] {
  39.         exec mkfifo "$path.1"
  40.         lappend tmpfd [open "$path.1" r+]
  41.         set stdout [open "$path.1" r]
  42.  
  43.         lappend EXEC(exec$EXEC_cnt:fd) $stdout
  44.         
  45.         if [info exists stderr] {
  46.             append cmd " >$path.1 "
  47.         } else {
  48.             append cmd " >&$path.1 "
  49.         }
  50.     }
  51.     if [info exists stderr] {
  52.         exec mkfifo "$path.2"
  53.         lappend tmpfd [open "$path.2" r+]
  54.         set stderr [open "$path.2" r]
  55.  
  56.         lappend EXEC(exec$EXEC_cnt:fd) $stderr
  57.             
  58.         append cmd " 2>$path.2 "
  59.     }
  60.     
  61.     set EXEC(exec$EXEC_cnt:cmd) $cmd
  62.     set EXEC(exec$EXEC_cnt:path) $path
  63.     set EXEC(exec$EXEC_cnt:pid) [eval "exec $cmd &"]
  64.     
  65.     foreach tempfd $tmpfd {
  66.         close $tempfd
  67.     }
  68.  
  69.     set tempfd [open "$path.pid" w]
  70.     puts $tempfd $EXEC(exec$EXEC_cnt:pid)
  71.     close $tempfd
  72.  
  73.     return "exec$EXEC_cnt"
  74. }
  75.  
  76. proc close_exec {id} {
  77.     global EXEC
  78.     
  79.     catch {exec kill $EXEC($id:pid)}
  80.     catch {close [lindex $EXEC($id:fd) 0]}; catch {file delete -force "$EXEC($id:path).0"}
  81.     catch {close [lindex $EXEC($id:fd) 1]}; catch {file delete -force "$EXEC($id:path).1"}
  82.     catch {close [lindex $EXEC($id:fd) 2]}; catch {file delete -force "$EXEC($id:path).2"}
  83.     catch {file delete -force "$EXEC($id:path).pid"}
  84.  
  85.     catch {unset EXEC($id:pid)}
  86.     catch {unset EXEC($id:path)}
  87.     catch {unset EXEC($id:cmd)}
  88.     catch {unset EXEC($id:fd)}
  89. }
  90.  
  91. proc exec_closeall {} {
  92.     global EXEC
  93.     
  94.     foreach {n v} [array get EXEC "*:path"] {
  95.         regexp {^(exec[0-9]+):} $n a id
  96.         close_exec $id
  97.     }
  98. }
  99.  
  100. proc exit { {status 0} } {
  101.     exec_closeall
  102.     tcl_core:exit $status
  103. }
  104.